out
}
qegpd <- function(p, scale=1, shape=0, alpha=0)
{
ea <- exp(alpha)
if (alpha!=0) p <- 1 - log(ea + p*(1-ea))/alpha
qgpd(p, scale=scale, shape=shape)
}
regpd <- function(x, scale=1, shape=0, alpha=0)
(1-pegpd(x, scale=scale, shape=shape, alpha))/degpd(x, scale=scale, shape=shape, alpha)
nlogL.egpd <- function(th, x) -2*sum( degpd(x, scale=exp(th[1]), shape=th[2], alpha=th[3], log=T) )
fegpd <- function(x, u=0)
{
y <- (x-u)[x>u]
fit <- evd::fpot(y,threshold=0)
est <- c(log(fit$estimate[1]),fit$estimate[2],0.01)
fit1 <- optim(par=est, fn=nlogL.egpd, method="Nelder", hessian=T, x=y)
if (fit1$convergence==0) { est <- fit1$par; est[1] <- exp(est[1])
h <- solve(fit1$hessian)
h[,1] <- h[,1]*est[1]; h[1,] <- h[1,]*est[1]
se <- sqrt(diag(h))
out <- list( value=fit1$value, est=est, se=se, cov=h, y=y) }
out
}
profile.egpd <- function (fit, alpha=seq(from=-10,to=10, length=101))
{ # fit is the result of a successful fit using fegpd
est <- matrix(NA,nrow=length(alpha),ncol=3); deviance <- alpha
nlogL <- function(th, x, a) -2*sum( degpd(x, scale=exp(th[1]), shape=th[2], alpha=a, log=T) )
for (i in 1:length(alpha))
{ temp <- optim(par=fit$est[-3], fn=nlogL, x=fit$y, a=alpha[i])
est[i,] <- c(temp$par,alpha[i])
deviance[i] <- temp$value }
list(est=est, deviance=deviance, y=fit$y)
}
plot.profile <- function(prof, eps=10^(-6))
{
par(mfrow=c(2,2),pty="s")
# deviance for alpha
dev <- prof$deviance-min(prof$deviance)
plot(prof$est[,3],dev,type="l",panel.first=abline(h=3.84,col="red"),ylim=c(0,10),
xlab=expression(alpha),ylab="Deviance")
# comparison of data and fitted density functions
y <- seq(from=eps,to=max(prof$y),length=1001)
best <- prof$est[dev==0,]
dy <- degpd( y, scale=exp(best[1]), shape=best[2], alpha=best[3])
fgpd <- fpot(prof$y, threshold=0)
d1 <- dgpd(y, scale=fgpd$estimate[1], shape=fgpd$estimate[2])
hist(prof$y,nclass=40,prob=T,xlab="Exceedance",ylab="Density", ylim=c(0,max(dy)),main="")
rug(prof$y)
lines(y, dy, col="red")
# d1[y==0] <- 1/fgpd$estimate[1]
lines(y, d1, col="blue")
# qqplot
n <- length(prof$y)
xq <- qgpd(c(1:n)/(n+1), scale=fgpd$estimate[1], shape=fgpd$estimate[2])
qqplot(xq, prof$y, xlab="GP quantiles", ylab="Empirical quantiles",pch=16,cex=0.5,
panel.first = abline(0,1,col="blue"))
p <- seq(from=eps,to=1-eps,length=1001)
lines(qgpd(p, scale=fgpd$estimate[1], shape=fgpd$estimate[2]),
qegpd(p, scale=exp(best[1]), shape=best[2], alpha=best[3]), col="red")
}
plot.profile(nidd.prof)
# some tests to see about a new EGPD
# the extra parameter is alpha, which can be positive or negative
# For kappa, consistent with other EPGD models, set kappa = exp(alpha)
pegpd <- function(x, scale=1, shape=0, alpha=0)
{
out <- evd::pgpd(x, scale=scale, shape=shape)
if (alpha!=0) out <- (exp(alpha*out)-1)/(exp(alpha)-1)
out
}
degpd <- function(x, scale=1, shape=0, alpha=0, log=FALSE)
{
out1 <- evd::pgpd(x, scale=scale, shape=shape)
out <- evd::dgpd(x, scale=scale, shape=shape)
out[x==0] <- 1/scale
if (alpha!=0) out <- alpha*out*exp(alpha*out1)/(exp(alpha)-1)
if (log) out <- log(out)
out
}
qegpd <- function(p, scale=1, shape=0, alpha=0)
{
ea <- exp(alpha)
if (alpha!=0) p <- log(1 + p*(ea-1))/alpha
qgpd(p, scale=scale, shape=shape)
}
regpd <- function(x, scale=1, shape=0, alpha=0)
(1-pegpd(x, scale=scale, shape=shape, alpha))/degpd(x, scale=scale, shape=shape, alpha)
nlogL.egpd <- function(th, x) -2*sum( degpd(x, scale=exp(th[1]), shape=th[2], alpha=th[3], log=T) )
fegpd <- function(x, u=0)
{
y <- (x-u)[x>u]
fit <- evd::fpot(y,threshold=0)
est <- c(log(fit$estimate[1]),fit$estimate[2],0.01)
fit1 <- optim(par=est, fn=nlogL.egpd, method="Nelder", hessian=T, x=y)
if (fit1$convergence==0) { est <- fit1$par; est[1] <- exp(est[1])
h <- solve(fit1$hessian)
h[,1] <- h[,1]*est[1]; h[1,] <- h[1,]*est[1]
se <- sqrt(diag(h))
out <- list( value=fit1$value, est=est, se=se, cov=h, y=y) }
out
}
profile.egpd <- function (fit, alpha=seq(from=-10,to=10, length=101))
{ # fit is the result of a successful fit using fegpd
est <- matrix(NA,nrow=length(alpha),ncol=3); deviance <- alpha
nlogL <- function(th, x, a) -2*sum( degpd(x, scale=exp(th[1]), shape=th[2], alpha=a, log=T) )
for (i in 1:length(alpha))
{ temp <- optim(par=fit$est[-3], fn=nlogL, x=fit$y, a=alpha[i])
est[i,] <- c(temp$par,alpha[i])
deviance[i] <- temp$value }
list(est=est, deviance=deviance, y=fit$y)
}
plot.profile <- function(prof, eps=10^(-6))
{
par(mfrow=c(2,2),pty="s")
# deviance for alpha
dev <- prof$deviance-min(prof$deviance)
plot(prof$est[,3],dev,type="l",panel.first=abline(h=3.84,col="red"),ylim=c(0,10),
xlab=expression(alpha),ylab="Deviance")
# comparison of data and fitted density functions
y <- seq(from=eps,to=max(prof$y),length=1001)
best <- prof$est[dev==0,]
dy <- degpd( y, scale=exp(best[1]), shape=best[2], alpha=best[3])
fgpd <- fpot(prof$y, threshold=0)
d1 <- dgpd(y, scale=fgpd$estimate[1], shape=fgpd$estimate[2])
hist(prof$y,nclass=40,prob=T,xlab="Exceedance",ylab="Density", ylim=c(0,max(dy)),main="")
rug(prof$y)
lines(y, dy, col="red")
# d1[y==0] <- 1/fgpd$estimate[1]
lines(y, d1, col="blue")
# qqplot
n <- length(prof$y)
xq <- qgpd(c(1:n)/(n+1), scale=fgpd$estimate[1], shape=fgpd$estimate[2])
qqplot(xq, prof$y, xlab="GP quantiles", ylab="Empirical quantiles",pch=16,cex=0.5,
panel.first = abline(0,1,col="blue"))
p <- seq(from=eps,to=1-eps,length=1001)
lines(qgpd(p, scale=fgpd$estimate[1], shape=fgpd$estimate[2]),
qegpd(p, scale=exp(best[1]), shape=best[2], alpha=best[3]), col="red")
}
nidd.egpd <- fegpd(nidd,u=70)
nidd.prof <- profile.egpd(nidd.egpd)
plot.profile(nidd.prof)
nidd.egpd <- fegpd(nidd,u=min(nidd))
nidd.prof <- profile.egpd(nidd.egpd)
nidd.egpd <- fegpd(nidd,u=min(nidd))
plot.profile(nidd.prof)
# some tests to see about a new EGPD
# the extra parameter is alpha, which can be positive or negative
# For kappa, consistent with other EPGD models, set kappa = exp(alpha)
pegpd <- function(x, scale=1, shape=0, alpha=0)
{
out <- evd::pgpd(x, scale=scale, shape=shape)
if (alpha!=0) out <- (exp(alpha*out)-1)/(exp(alpha)-1)
out
}
degpd <- function(x, scale=1, shape=0, alpha=0, log=FALSE)
{
out1 <- evd::pgpd(x, scale=scale, shape=shape)
out <- evd::dgpd(x, scale=scale, shape=shape)
out[x==0] <- 1/scale
if (alpha!=0) out <- alpha*out*exp(alpha*out1)/(exp(alpha)-1)
if (log) out <- log(out)
out
}
qegpd <- function(p, scale=1, shape=0, alpha=0)
{
ea <- exp(alpha)
if (alpha!=0) p <- log(1 + p*(ea-1))/alpha
qgpd(p, scale=scale, shape=shape)
}
regpd <- function(x, scale=1, shape=0, alpha=0)
(1-pegpd(x, scale=scale, shape=shape, alpha))/degpd(x, scale=scale, shape=shape, alpha)
nlogL.egpd <- function(th, x) -2*sum( degpd(x, scale=exp(th[1]), shape=th[2], alpha=th[3], log=T) )
fegpd <- function(x, u=0)
{
y <- (x-u)[x>u]
fit <- evd::fpot(y,threshold=0)
est <- c(log(fit$estimate[1]),fit$estimate[2],0.01)
fit1 <- optim(par=est, fn=nlogL.egpd, method="Nelder", hessian=T, x=y)
if (fit1$convergence==0) { est <- fit1$par; est[1] <- exp(est[1])
h <- solve(fit1$hessian)
h[,1] <- h[,1]*est[1]; h[1,] <- h[1,]*est[1]
se <- sqrt(diag(h))
out <- list( value=fit1$value, est=est, se=se, cov=h, y=y) }
out
}
profile.egpd <- function (fit, alpha=seq(from=-10,to=10, length=101))
{ # fit is the result of a successful fit using fegpd
est <- matrix(NA,nrow=length(alpha),ncol=3); deviance <- alpha
nlogL <- function(th, x, a) -2*sum( degpd(x, scale=exp(th[1]), shape=th[2], alpha=a, log=T) )
for (i in 1:length(alpha))
{ temp <- optim(par=fit$est[-3], fn=nlogL, x=fit$y, a=alpha[i])
est[i,] <- c(temp$par,alpha[i])
deviance[i] <- temp$value }
list(est=est, deviance=deviance, y=fit$y)
}
plot.profile <- function(prof, eps=10^(-6))
{
par(mfrow=c(2,2),pty="s")
# deviance for alpha
fgpd <- fpot(prof$y, threshold=0)
dev <- prof$deviance
plot(prof$est[,3],dev,type="l",panel.first={ abline(h=min(dev)+3.84,col="red"); abline(h=min(dev),col="grey") },
ylim=min(dev)+c(0,10), xlab=expression(alpha),ylab="Deviance",)
# comparison of data and fitted density functions
y <- seq(from=eps,to=max(prof$y),length=1001)
best <- prof$est[dev==0,]
dy <- degpd( y, scale=exp(best[1]), shape=best[2], alpha=best[3])
fgpd <- fpot(prof$y, threshold=0)
d1 <- dgpd(y, scale=fgpd$estimate[1], shape=fgpd$estimate[2])
hist(prof$y,nclass=40,prob=T,xlab="Exceedance",ylab="Density", ylim=c(0,max(dy)),main="")
rug(prof$y)
lines(y, dy, col="red")
# d1[y==0] <- 1/fgpd$estimate[1]
lines(y, d1, col="blue")
# qqplot
n <- length(prof$y)
xq <- qgpd(c(1:n)/(n+1), scale=fgpd$estimate[1], shape=fgpd$estimate[2])
qqplot(xq, prof$y, xlab="GP quantiles", ylab="Empirical quantiles",pch=16,cex=0.5,
panel.first = abline(0,1,col="blue"))
p <- seq(from=eps,to=1-eps,length=1001)
lines(qgpd(p, scale=fgpd$estimate[1], shape=fgpd$estimate[2]),
qegpd(p, scale=exp(best[1]), shape=best[2], alpha=best[3]), col="red")
}
plot.profile(nidd.prof)
# some tests to see about a new EGPD
# the extra parameter is alpha, which can be positive or negative
# For kappa, consistent with other EPGD models, set kappa = exp(alpha)
pegpd <- function(x, scale=1, shape=0, alpha=0)
{
out <- evd::pgpd(x, scale=scale, shape=shape)
if (alpha!=0) out <- (exp(alpha*out)-1)/(exp(alpha)-1)
out
}
degpd <- function(x, scale=1, shape=0, alpha=0, log=FALSE)
{
out1 <- evd::pgpd(x, scale=scale, shape=shape)
out <- evd::dgpd(x, scale=scale, shape=shape)
out[x==0] <- 1/scale
if (alpha!=0) out <- alpha*out*exp(alpha*out1)/(exp(alpha)-1)
if (log) out <- log(out)
out
}
qegpd <- function(p, scale=1, shape=0, alpha=0)
{
ea <- exp(alpha)
if (alpha!=0) p <- log(1 + p*(ea-1))/alpha
qgpd(p, scale=scale, shape=shape)
}
regpd <- function(x, scale=1, shape=0, alpha=0)
(1-pegpd(x, scale=scale, shape=shape, alpha))/degpd(x, scale=scale, shape=shape, alpha)
nlogL.egpd <- function(th, x) -2*sum( degpd(x, scale=exp(th[1]), shape=th[2], alpha=th[3], log=T) )
fegpd <- function(x, u=0)
{
y <- (x-u)[x>u]
fit <- evd::fpot(y,threshold=0)
est <- c(log(fit$estimate[1]),fit$estimate[2],0.01)
fit1 <- optim(par=est, fn=nlogL.egpd, method="Nelder", hessian=T, x=y)
if (fit1$convergence==0) { est <- fit1$par; est[1] <- exp(est[1])
h <- solve(fit1$hessian)
h[,1] <- h[,1]*est[1]; h[1,] <- h[1,]*est[1]
se <- sqrt(diag(h))
out <- list( value=fit1$value, est=est, se=se, cov=h, y=y) }
out
}
profile.egpd <- function (fit, alpha=seq(from=-10,to=10, length=101))
{ # fit is the result of a successful fit using fegpd
est <- matrix(NA,nrow=length(alpha),ncol=3); deviance <- alpha
nlogL <- function(th, x, a) -2*sum( degpd(x, scale=exp(th[1]), shape=th[2], alpha=a, log=T) )
for (i in 1:length(alpha))
{ temp <- optim(par=fit$est[-3], fn=nlogL, x=fit$y, a=alpha[i])
est[i,] <- c(temp$par,alpha[i])
deviance[i] <- temp$value }
list(est=est, deviance=deviance, y=fit$y)
}
plot.profile <- function(prof, eps=10^(-6))
{
par(mfrow=c(2,2),pty="s")
# deviance for alpha
fgpd <- fpot(prof$y, threshold=0)
dev <- prof$deviance
plot(prof$est[,3],dev,type="l",panel.first={ abline(h=min(dev)+3.84,col="red"); abline(h=min(dev),col="grey") },
ylim=min(dev)+c(0,10), xlab=expression(alpha),ylab="Deviance",)
# comparison of data and fitted density functions
y <- seq(from=eps,to=max(prof$y),length=1001)
best <- prof$est[dev==min(dev),]
dy <- degpd( y, scale=exp(best[1]), shape=best[2], alpha=best[3])
d1 <- dgpd(y, scale=fgpd$estimate[1], shape=fgpd$estimate[2])
hist(prof$y,nclass=40,prob=T,xlab="Exceedance",ylab="Density", ylim=c(0,max(dy)),main="")
rug(prof$y)
lines(y, dy, col="red")
# d1[y==0] <- 1/fgpd$estimate[1]
lines(y, d1, col="blue")
# qqplot
n <- length(prof$y)
xq <- qgpd(c(1:n)/(n+1), scale=fgpd$estimate[1], shape=fgpd$estimate[2])
qqplot(xq, prof$y, xlab="GP quantiles", ylab="Empirical quantiles",pch=16,cex=0.5,
panel.first = abline(0,1,col="blue"))
p <- seq(from=eps,to=1-eps,length=1001)
lines(qgpd(p, scale=fgpd$estimate[1], shape=fgpd$estimate[2]),
qegpd(p, scale=exp(best[1]), shape=best[2], alpha=best[3]), col="red")
}
plot.profile(nidd.prof)
# some tests to see about a new EGPD
# the extra parameter is alpha, which can be positive or negative
# For kappa, consistent with other EPGD models, set kappa = exp(alpha)
pegpd <- function(x, scale=1, shape=0, alpha=0)
{
out <- evd::pgpd(x, scale=scale, shape=shape)
if (alpha!=0) out <- (exp(alpha*out)-1)/(exp(alpha)-1)
out
}
degpd <- function(x, scale=1, shape=0, alpha=0, log=FALSE)
{
out1 <- evd::pgpd(x, scale=scale, shape=shape)
out <- evd::dgpd(x, scale=scale, shape=shape)
out[x==0] <- 1/scale
if (alpha!=0) out <- alpha*out*exp(alpha*out1)/(exp(alpha)-1)
if (log) out <- log(out)
out
}
qegpd <- function(p, scale=1, shape=0, alpha=0)
{
ea <- exp(alpha)
if (alpha!=0) p <- log(1 + p*(ea-1))/alpha
qgpd(p, scale=scale, shape=shape)
}
regpd <- function(x, scale=1, shape=0, alpha=0)
(1-pegpd(x, scale=scale, shape=shape, alpha))/degpd(x, scale=scale, shape=shape, alpha)
nlogL.egpd <- function(th, x) -2*sum( degpd(x, scale=exp(th[1]), shape=th[2], alpha=th[3], log=T) )
fegpd <- function(x, u=0)
{
y <- (x-u)[x>u]
fit <- evd::fpot(y,threshold=0)
est <- c(log(fit$estimate[1]),fit$estimate[2],0.01)
fit1 <- optim(par=est, fn=nlogL.egpd, method="Nelder", hessian=T, x=y)
if (fit1$convergence==0) { est <- fit1$par; est[1] <- exp(est[1])
h <- solve(fit1$hessian)
h[,1] <- h[,1]*est[1]; h[1,] <- h[1,]*est[1]
se <- sqrt(diag(h))
out <- list( value=fit1$value, est=est, se=se, cov=h, y=y) }
out
}
profile.egpd <- function (fit, alpha=seq(from=-10,to=10, length=101))
{ # fit is the result of a successful fit using fegpd
est <- matrix(NA,nrow=length(alpha),ncol=3); deviance <- alpha
nlogL <- function(th, x, a) -2*sum( degpd(x, scale=exp(th[1]), shape=th[2], alpha=a, log=T) )
for (i in 1:length(alpha))
{ temp <- optim(par=fit$est[-3], fn=nlogL, x=fit$y, a=alpha[i])
est[i,] <- c(temp$par,alpha[i])
deviance[i] <- temp$value }
list(est=est, deviance=deviance, y=fit$y)
}
plot.profile <- function(prof, eps=10^(-6))
{
par(mfrow=c(2,2),pty="s")
# deviance for alpha
fgpd <- fpot(prof$y, threshold=0)
dev <- prof$deviance
plot(prof$est[,3],dev,type="l",panel.first={ abline(h=min(dev)+c(0,3.84),col="grey") },
ylim=min(dev)+c(0,10), xlab=expression(alpha),ylab="Deviance",)
# comparison of data and fitted density functions
y <- seq(from=eps,to=max(prof$y),length=1001)
best <- prof$est[dev==min(dev),]
dy <- degpd( y, scale=exp(best[1]), shape=best[2], alpha=best[3])
d1 <- dgpd(y, scale=fgpd$estimate[1], shape=fgpd$estimate[2])
hist(prof$y,nclass=40,prob=T,xlab="Exceedance",ylab="Density", ylim=c(0,max(dy)),main="")
rug(prof$y)
lines(y, dy, col="red")
# d1[y==0] <- 1/fgpd$estimate[1]
lines(y, d1, col="blue")
# qqplot
n <- length(prof$y)
xq <- qgpd(c(1:n)/(n+1), scale=fgpd$estimate[1], shape=fgpd$estimate[2])
qqplot(xq, prof$y, xlab="GP quantiles", ylab="Empirical quantiles",pch=16,cex=0.5,
panel.first = abline(0,1,col="blue"))
p <- seq(from=eps,to=1-eps,length=1001)
lines(qgpd(p, scale=fgpd$estimate[1], shape=fgpd$estimate[2]),
qegpd(p, scale=exp(best[1]), shape=best[2], alpha=best[3]), col="red")
}
plot.profile(nidd.prof)
nidd.egpd
# some tests to see about a new EGPD
# the extra parameter is alpha, which can be positive or negative
# For kappa, consistent with other EPGD models, set kappa = exp(alpha)
pegpd <- function(x, scale=1, shape=0, alpha=0)
{
out <- evd::pgpd(x, scale=scale, shape=shape)
if (alpha!=0) out <- (exp(-alpha*out)-1)/(exp(-alpha)-1)
out
}
degpd <- function(x, scale=1, shape=0, alpha=0, log=FALSE)
{
out1 <- evd::pgpd(x, scale=scale, shape=shape)
out <- evd::dgpd(x, scale=scale, shape=shape)
out[x==0] <- 1/scale
if (alpha!=0) out <- alpha*out*exp(alpha*(1-out1))/(exp(alpha)-1)
if (log) out <- log(out)
out
}
qegpd <- function(p, scale=1, shape=0, alpha=0)
{
ea <- exp(alpha)
if (alpha!=0) p <- 1 - log(ea + p*(1-ea))/alpha
qgpd(p, scale=scale, shape=shape)
}
regpd <- function(x, scale=1, shape=0, alpha=0)
(1-pegpd(x, scale=scale, shape=shape, alpha))/degpd(x, scale=scale, shape=shape, alpha)
nlogL.egpd <- function(th, x) -2*sum( degpd(x, scale=exp(th[1]), shape=th[2], alpha=th[3], log=T) )
fegpd <- function(x, u=0)
{
y <- (x-u)[x>u]
fit <- evd::fpot(y,threshold=0)
est <- c(log(fit$estimate[1]),fit$estimate[2],0.01)
fit1 <- optim(par=est, fn=nlogL.egpd, method="Nelder", hessian=T, x=y)
if (fit1$convergence==0) { est <- fit1$par; est[1] <- exp(est[1])
h <- solve(fit1$hessian)
h[,1] <- h[,1]*est[1]; h[1,] <- h[1,]*est[1]
se <- sqrt(diag(h))
out <- list( value=fit1$value, est=est, se=se, cov=h, y=y) }
out
}
profile.egpd <- function (fit, alpha=seq(from=-10,to=10, length=101))
{ # fit is the result of a successful fit using fegpd
est <- matrix(NA,nrow=length(alpha),ncol=3); deviance <- alpha
nlogL <- function(th, x, a) -2*sum( degpd(x, scale=exp(th[1]), shape=th[2], alpha=a, log=T) )
for (i in 1:length(alpha))
{ temp <- optim(par=fit$est[-3], fn=nlogL, x=fit$y, a=alpha[i])
est[i,] <- c(temp$par,alpha[i])
deviance[i] <- temp$value }
list(est=est, deviance=deviance, y=fit$y)
}
plot.profile <- function(prof, eps=10^(-6))
{
par(mfrow=c(2,2),pty="s")
# deviance for alpha
fgpd <- fpot(prof$y, threshold=0)
dev <- prof$deviance
plot(prof$est[,3],dev,type="l",panel.first={ abline(h=min(dev)+c(0,3.84),col="grey") },
ylim=min(dev)+c(0,10), xlab=expression(alpha),ylab="Deviance",)
# comparison of data and fitted density functions
y <- seq(from=eps,to=max(prof$y),length=1001)
best <- prof$est[dev==min(dev),]
dy <- degpd( y, scale=exp(best[1]), shape=best[2], alpha=best[3])
d1 <- dgpd(y, scale=fgpd$estimate[1], shape=fgpd$estimate[2])
hist(prof$y,nclass=40,prob=T,xlab="Exceedance",ylab="Density", ylim=c(0,max(dy)),main="")
rug(prof$y)
lines(y, dy, col="red")
# d1[y==0] <- 1/fgpd$estimate[1]
lines(y, d1, col="blue")
# qqplot
n <- length(prof$y)
xq <- qgpd(c(1:n)/(n+1), scale=fgpd$estimate[1], shape=fgpd$estimate[2])
qqplot(xq, prof$y, xlab="GP quantiles", ylab="Empirical quantiles",pch=16,cex=0.5,
panel.first = abline(0,1,col="blue"))
p <- seq(from=eps,to=1-eps,length=1001)
lines(qgpd(p, scale=fgpd$estimate[1], shape=fgpd$estimate[2]),
qegpd(p, scale=exp(best[1]), shape=best[2], alpha=best[3]), col="red")
}
nidd.egpd <- fegpd(nidd,u=min(nidd))
nidd.prof <- profile.egpd(nidd.egpd)
plot.profile(nidd.prof)
?mev::egp
fit1 <- mev::fit.egp(nidd,min(nidd),model="egp1")
fit1 <- mev::fit.egp(nidd,min(nidd),model="egp1",init=c(0.9,25,0.5))
fit1 <- mev::fit.egp(nidd,min(nidd),model="egp1",init=c(1,25,0.5))
fit1 <- mev::fit.egp(nidd,min(nidd),model="egp1",init=c(1,25,0.1))
fit1 <- mev::fit.egp(nidd,min(nidd),model="egp1",init=c(1,25,0.1)show=T)
fit1 <- mev::fit.egp(nidd,min(nidd),model="egp1",init=c(1,25,0.1),show=T)
fit1 <- mev::fit.egp(nidd,min(nidd),model="egp1",init=c(0,5,0.1),show=T)
fit1 <- mev::fit.egp(nidd,min(nidd),model="egp1",show=T)
fpot(nidd,min(nidd))
fit1 <- mev::fit.egp(nidd,min(nidd),model="egp1",init=c(0,log(26),0.2),show=T)
fit1 <- mev::fit.egp(nidd,min(nidd),model="egp1",init=c(0.01,log(26),0.2),show=T)
fit1 <- mev::fit.egp(nidd,min(nidd),model="egp1",init=c(-0.01,log(26),0.2),show=T)
fit1 <- mev::fit.egp(nidd,min(nidd),model="egp1",init=c(1,log(26),0.2),show=T)
fit1 <- mev::fit.egp(nidd,min(nidd),model="egp1",init=c(1,26,0.2),show=T)
library(mev)
egp.ll(nidd,min(nidd),model="egp1",par = =c(1,26,0.2))
egp.ll(nidd,min(nidd),model="egp1",par=c(1,26,0.2))
egp.ll(nidd,min(nidd),model="egp1",par=c(0.99,26,0.2))
egp.ll(nidd,65,model="egp1",par=c(0.99,26,0.2))
fit1 <- mev::fit.egp(nidd,65,model="egp1",init=c(1,26,0.2),show=T)
ls()
nidd.egpd
fpot(nidd,65)
nidd.egpd <- fegpd(nidd,u=65
)
nidd.egpd
min(nidd)
nidd.egpd <- fegpd(nidd,u=65.07)
nodd.egpd
n1dd.egpd
nidd.egpd
fit1 <- mev::fit.egp(nidd,65,model="egp2",init=c(1,26,0.2),show=T)
fpot(nidd,65)
fit1 <- mev::fit.egp(nidd,65,model="egp1",init=c(1,26,0.2),show=T)
fit1 <- mev::fit.egp(nidd,65,model="egp3",init=c(1,26,0.2),show=T)
fpot(nidd,70)
nidd.egpd <- fegpd(nidd,u=70)
nidd.egpd
fit1 <- mev::fit.egp(nidd,70,model="egp1",init=c(1,26,0.2),show=T)
fit1 <- mev::fit.egp(nidd,70,model="egp2",init=c(1,26,0.2),show=T)
fit1 <- mev::fit.egp(nidd,70,model="egp3",init=c(1,26,0.2),show=T)
nidd.prof <- profile.egpd(nidd.egpd)
plot.profile(nidd.prof)
nidd.egpd
fit1 <- mev::fit.egp(nidd,70,model="egp2",init=c(1,26,0.2),show=T)
fpot(nidd,70)
setwd("/Users/davison/Library/CloudStorage/Dropbox/Regression Methods/Projects/2024/coin data")
source(file = "functions/binomial-test.R")
df <- read.csv(file = "analyses/data_long.csv")
